home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pas_all.zip
/
TI675.ASC
< prev
next >
Wrap
Text File
|
1992-09-03
|
6KB
|
331 lines
PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : September 3, 1992 PAGE : 1/5
TITLE : Simple Pick List Example
{
The following example is to demonstrate the use of a Pick List.
This Pick List will read a line of data and validate the field
as well as keep a history of valid commands.
}
{$X+}
Program PickListExample;
uses Objects, App, Menus, Drivers, Views, Dialogs, MsgBox;
type
YourKeySet = set of char;
const
cmMakeDialog = 101;
ValidSet : YourKeySet = [#0..#31,'0'..'9'];
type
PFInputLine = ^TFInputLine;
TFInputLine = object(TInputLine)
ValidKeys : YourKeySet;
constructor Init(var Bounds: TRect; AMaxLen: integer;
ChrSet: YourKeySet);
procedure HandleEvent(var Event: TEvent); virtual;
procedure GetData(var Rec); virtual;
procedure SetData(var Rec); virtual;
function DataSize: word; virtual;
end;
PMyApp = ^TMyApp;
TMyApp = object(TApplication)
procedure InitMenuBar;virtual;
procedure InitStatusLine;virtual;
procedure MakeDialog;
procedure HandleEvent(var Event: TEvent);virtual;
end;
constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
ChrSet: YourKeySet);
begin
PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : September 3, 1992 PAGE : 2/5
TITLE : Simple Pick List Example
TInputLine.Init(Bounds,AMaxLen);
ValidKeys:= ChrSet;
end;
procedure TFInputLine.HandleEvent(var Event: TEvent);
{
Data validation handle event:
Please note that validation happens BEFORE the parent
is called. This ensures that the key is not trapped by
the parent method.
}
var
Number : longint;
Code : integer;
begin
case Event.What of
evKeyDown :
begin
if not(Event.CharCode in ValidKeys) then
ClearEvent(Event)
else
if Data^ <> '' then
begin
val(Data^, Number, Code);
if (Code <> 0) or (Number < 0) or (Number > 65535)
then
begin
Data^ := '';
MessageBox('Valid number is 0 to
65536.',nil,mfOkButton);
ClearEvent(Event);
end;
end;
end;
end;
TInputLine.HandleEvent(Event);
end;
procedure TFInputLine.GetData(var Rec);
var
Code : integer;
begin
PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : September 3, 1992 PAGE : 3/5
TITLE : Simple Pick List Example
Val(Data^,word(Rec), Code);
end;
procedure TFInputLine.SetData(var Rec);
begin
Str(word(Rec),Data^);
end;
function TFInputLine.DataSize: word;
begin
DataSize := SizeOf(word);
end;
procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~T~est', hcNoContext, NewMenu(
NewItem('~D~ialog','F2',kbF2,cmMakeDialog,hcNoContext,
NewLine(
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil)))),nil))));
end;
procedure TMyApp.MakeDialog;
var
R : TRect;
Dialog : PDialog;
InputLine : PInputLine;
Lable,Hist : PView;
begin
GetExtent(R);
R.Assign(10,5,60,15);
Dialog := New(PDialog,Init(R,'Demo Dialog'));
With Dialog^ do
begin
R.Assign(5,4,20,5);
InputLine := New(PFInputLine,Init(R,15,ValidSet));
Insert(InputLine);
R.Assign(5,3,20,4);
Lable := New(PLabel,Init(R,'InputLine',Inputline));
PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : September 3, 1992 PAGE : 4/5
TITLE : Simple Pick List Example
Insert(Lable);
R.Assign(21,4,23,5);
Hist := New(PHistory,Init(R,InputLine,0));
Insert(Hist);
end;
Desktop^.ExecView(Dialog);
Dispose(Dialog,Done);
end;
procedure TMyApp.InitStatusLine;
var
R : TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine,Init(R,
NewStatusDef(0,$FFFF,
NewStatusKey('~A~lt-X',kbAltX,cmQuit,
nil),nil)));
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmMakeDialog: MakeDialog;
else
Exit;
end;
ClearEvent(Event);
end;
end;
var
MyApp: TMyApp;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : September 3, 1992 PAGE : 5/5
TITLE : Simple Pick List Example
DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.